Library / Packagess

Package R yang akan digunakan pada perkuliahan Analisis Deret Waktu sesi UTS adalah: forecast, graphics, TTR, TSA . Jika package tersebut belum ada, silakan install terlebih dahulu.

#install.packages("forecast")
#install.packages("graphics")
#install.packages("TTR")
#install.packages("TSA")
#install.packages("ggplot2")

Jika sudah ada, silakan panggil library package tersebut.

library("forecast")
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library("graphics")
library("TTR")
library("TSA")
## Registered S3 methods overwritten by 'TSA':
##   method       from    
##   fitted.Arima forecast
##   plot.Arima   forecast
## 
## Attaching package: 'TSA'
## The following objects are masked from 'package:stats':
## 
##     acf, arima
## The following object is masked from 'package:utils':
## 
##     tar
library("ggplot2")

Penjelasan Data

Data yang digunakan pada analisis ini ialah data bursa saham dengan peubah volume(juta) bursa saham. Volume bursa saham adalah data yang mengukur jumlah saham yang diperdagangkan dalam suatu instrumen keuangan (seperti saham, obligasi, atau reksa dana) selama suatu periode waktu tertentu di pasar saham. Data volume memberikan informasi tentang sejauh mana pasar aktif pada suatu hari perdagangan dan dapat memberikan wawasan tentang minat dan partisipasi investor dalam aset tersebut. Volume perdagangan yang tinggi sering menjadi pertanda bahwa terdapat minat yang besar dalam aset tersebut, sementara volume yang rendah dapat menunjukkan kurangnya minat atau ketidakpastian di pasar.

Data yang digunakan berasal dari www.bps.go.id

Impor Data

library(rio)
datampdw <- import("https://raw.githubusercontent.com/RadhityaHarma12/MPDW/main/Pertemuan%201/datampdw.csv")

Eksplorasi Data

Melihat data menggunakan fungsi View(), struktur data menggunakan fungsi str(), dan dimensi data menggunakan fungsi dim().

View(datampdw)
str(datampdw)
## 'data.frame':    120 obs. of  2 variables:
##  $ date: chr  "Jan-13" "Feb-13" "Mar-13" "Apr-13" ...
##  $ x   : int  97907 136954 141112 128263 135960 119400 95011 91423 113009 100552 ...
dim(datampdw)
## [1] 120   2

Mengubah data agar terbaca sebagai data deret waktu dengan fungsi ts() .

datampdw.ts <- ts(datampdw$x)

Menampilkan ringkasan data

summary(datampdw.ts)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   78078  121592  198502  239331  304183  649089

Membuat plot data deret waktu

ts.plot(datampdw.ts, xlab="Time Period ", ylab="Volume Saham", 
        main = "Time Series Plot")
points(datampdw.ts)

Menyimpan plot

#menyimpan plot
#dev.copy(png, "eksplorasi.png")
#dev.off()

Single Moving Average & Double Moving Average

Pembagian Data

Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.

#membagi data latih dan data uji
training_ma <- datampdw[1:96,]
testing_ma <- datampdw[97:120,]
train_ma.ts <- ts(training_ma$x)
test_ma.ts <- ts(testing_ma$x)

Eksplorasi Data

Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.

#eksplorasi keseluruhan data
plot(datampdw.ts, col="red",main="Plot semua data")
points(datampdw.ts)

#eksplorasi data latih
plot(train_ma.ts, col="blue",main="Plot data latih")
points(train_ma.ts)

#eksplorasi data uji
plot(test_ma.ts, col="blue",main="Plot data uji")
points(test_ma.ts)

Eksplorasi data juga dapat dilakukan menggunakan package ggplot2 dengan terlebih dahulu memanggil library package ggplot2.

Single Moving Average (SMA)

Ide dasar dari Single Moving Average (SMA) adalah data suatu periode dipengaruhi oleh data periode sebelumnya. Metode pemulusan ini cocok digunakan untuk pola data stasioner atau konstan. Prinsip dasar metode pemulusan ini adalah data pemulusan pada periode ke-t merupakan rata rata dari m buah data pada periode ke-t hingga periode ke (t-m+1). Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1

Pemulusan menggunakan metode SMA dilakukan dengan fungsi SMA(). Dalam hal ini akan dilakukan pemulusan dengan parameter m=4.

data.sma<-SMA(train_ma.ts, n=4)
data.sma
## Time Series:
## Start = 1 
## End = 96 
## Frequency = 1 
##  [1]        NA        NA        NA 126059.00 135572.25 131183.75 119658.50
##  [8] 110448.50 104710.75  99998.75  98496.75  99156.25  90423.50  87709.75
## [15]  94451.75  98104.75 101161.75 102799.00 102965.75 103250.25 112538.75
## [22] 116980.00 115652.00 130398.50 135518.75 136273.25 142834.00 136203.00
## [29] 127740.25 127480.25 115662.00 107537.50 107167.50 112818.50 113722.50
## [36] 117838.00 109474.50  98524.00 107871.00 104894.25 108637.75 120697.75
## [43] 114811.50 130357.75 146955.50 178546.75 222533.75 246102.75 281777.50
## [50] 318197.00 316108.00 299234.75 283435.25 215076.25 186790.25 182634.75
## [57] 165212.00 179515.50 200450.50 229341.75 251058.00 271897.50 270077.00
## [64] 241705.25 223649.75 186366.50 177527.75 177964.25 176233.00 199655.50
## [71] 200398.00 214400.25 243266.00 254615.75 278238.75 289116.50 286884.50
## [78] 275185.75 300149.75 312323.00 317944.75 357427.25 314286.75 289152.25
## [85] 253472.25 188227.50 167035.25 147112.50 140321.50 159279.00 175200.50
## [92] 189851.75 216208.00 222418.50 274461.75 351153.50

Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1 sehingga hasil peramalan 1 periode kedepan adalah sebagai berikut.

data.ramal<-c(NA,data.sma)
data.ramal #forecast 1 periode ke depan
##  [1]        NA        NA        NA        NA 126059.00 135572.25 131183.75
##  [8] 119658.50 110448.50 104710.75  99998.75  98496.75  99156.25  90423.50
## [15]  87709.75  94451.75  98104.75 101161.75 102799.00 102965.75 103250.25
## [22] 112538.75 116980.00 115652.00 130398.50 135518.75 136273.25 142834.00
## [29] 136203.00 127740.25 127480.25 115662.00 107537.50 107167.50 112818.50
## [36] 113722.50 117838.00 109474.50  98524.00 107871.00 104894.25 108637.75
## [43] 120697.75 114811.50 130357.75 146955.50 178546.75 222533.75 246102.75
## [50] 281777.50 318197.00 316108.00 299234.75 283435.25 215076.25 186790.25
## [57] 182634.75 165212.00 179515.50 200450.50 229341.75 251058.00 271897.50
## [64] 270077.00 241705.25 223649.75 186366.50 177527.75 177964.25 176233.00
## [71] 199655.50 200398.00 214400.25 243266.00 254615.75 278238.75 289116.50
## [78] 286884.50 275185.75 300149.75 312323.00 317944.75 357427.25 314286.75
## [85] 289152.25 253472.25 188227.50 167035.25 147112.50 140321.50 159279.00
## [92] 175200.50 189851.75 216208.00 222418.50 274461.75 351153.50

Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 24 periode. Pada metode SMA, hasil peramalan 24 periode ke depan akan bernilai sama dengan hasil peramalan 1 periode kedepan. Dalam hal ini akan dilakukan pengguabungan data aktual train, data hasil pemulusan dan data hasil ramalan 24 periode kedepan.

data.gab<-cbind(aktual=c(train_ma.ts,rep(NA,24)),pemulusan=c(data.sma,rep(NA,24)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],23)))
data.gab #forecast 24 periode ke depan
##        aktual pemulusan   ramalan
##   [1,]  97907        NA        NA
##   [2,] 136954        NA        NA
##   [3,] 141112        NA        NA
##   [4,] 128263 126059.00        NA
##   [5,] 135960 135572.25 126059.00
##   [6,] 119400 131183.75 135572.25
##   [7,]  95011 119658.50 131183.75
##   [8,]  91423 110448.50 119658.50
##   [9,] 113009 104710.75 110448.50
##  [10,] 100552  99998.75 104710.75
##  [11,]  89003  98496.75  99998.75
##  [12,]  94061  99156.25  98496.75
##  [13,]  78078  90423.50  99156.25
##  [14,]  89697  87709.75  90423.50
##  [15,] 115971  94451.75  87709.75
##  [16,] 108673  98104.75  94451.75
##  [17,]  90306 101161.75  98104.75
##  [18,]  96246 102799.00 101161.75
##  [19,] 116638 102965.75 102799.00
##  [20,] 109811 103250.25 102965.75
##  [21,] 127460 112538.75 103250.25
##  [22,] 114011 116980.00 112538.75
##  [23,] 111326 115652.00 116980.00
##  [24,] 168797 130398.50 115652.00
##  [25,] 147941 135518.75 130398.50
##  [26,] 117029 136273.25 135518.75
##  [27,] 137569 142834.00 136273.25
##  [28,] 142273 136203.00 142834.00
##  [29,] 114090 127740.25 136203.00
##  [30,] 115989 127480.25 127740.25
##  [31,]  90296 115662.00 127480.25
##  [32,] 109775 107537.50 115662.00
##  [33,] 112610 107167.50 107537.50
##  [34,] 138593 112818.50 107167.50
##  [35,]  93912 113722.50 112818.50
##  [36,] 126237 117838.00 113722.50
##  [37,]  79156 109474.50 117838.00
##  [38,]  94791  98524.00 109474.50
##  [39,] 131300 107871.00  98524.00
##  [40,] 114330 104894.25 107871.00
##  [41,]  94130 108637.75 104894.25
##  [42,] 143031 120697.75 108637.75
##  [43,] 107755 114811.50 120697.75
##  [44,] 176515 130357.75 114811.50
##  [45,] 160521 146955.50 130357.75
##  [46,] 269396 178546.75 146955.50
##  [47,] 283703 222533.75 178546.75
##  [48,] 270791 246102.75 222533.75
##  [49,] 303220 281777.50 246102.75
##  [50,] 415074 318197.00 281777.50
##  [51,] 275347 316108.00 318197.00
##  [52,] 203298 299234.75 316108.00
##  [53,] 240022 283435.25 299234.75
##  [54,] 141638 215076.25 283435.25
##  [55,] 162203 186790.25 215076.25
##  [56,] 186676 182634.75 186790.25
##  [57,] 170331 165212.00 182634.75
##  [58,] 198852 179515.50 165212.00
##  [59,] 245943 200450.50 179515.50
##  [60,] 302241 229341.75 200450.50
##  [61,] 257196 251058.00 229341.75
##  [62,] 282210 271897.50 251058.00
##  [63,] 238661 270077.00 271897.50
##  [64,] 188754 241705.25 270077.00
##  [65,] 184974 223649.75 241705.25
##  [66,] 133077 186366.50 223649.75
##  [67,] 203306 177527.75 186366.50
##  [68,] 190500 177964.25 177527.75
##  [69,] 178049 176233.00 177964.25
##  [70,] 226767 199655.50 176233.00
##  [71,] 206276 200398.00 199655.50
##  [72,] 246509 214400.25 200398.00
##  [73,] 293512 243266.00 214400.25
##  [74,] 272166 254615.75 243266.00
##  [75,] 300768 278238.75 254615.75
##  [76,] 290020 289116.50 278238.75
##  [77,] 284584 286884.50 289116.50
##  [78,] 225371 275185.75 286884.50
##  [79,] 400624 300149.75 275185.75
##  [80,] 338713 312323.00 300149.75
##  [81,] 307071 317944.75 312323.00
##  [82,] 383301 357427.25 317944.75
##  [83,] 228062 314286.75 357427.25
##  [84,] 238175 289152.25 314286.75
##  [85,] 164351 253472.25 289152.25
##  [86,] 122322 188227.50 253472.25
##  [87,] 143293 167035.25 188227.50
##  [88,] 158484 147112.50 167035.25
##  [89,] 137187 140321.50 147112.50
##  [90,] 198152 159279.00 140321.50
##  [91,] 206979 175200.50 159279.00
##  [92,] 217089 189851.75 175200.50
##  [93,] 242612 216208.00 189851.75
##  [94,] 222994 222418.50 216208.00
##  [95,] 415152 274461.75 222418.50
##  [96,] 523856 351153.50 274461.75
##  [97,]     NA        NA 351153.50
##  [98,]     NA        NA 351153.50
##  [99,]     NA        NA 351153.50
## [100,]     NA        NA 351153.50
## [101,]     NA        NA 351153.50
## [102,]     NA        NA 351153.50
## [103,]     NA        NA 351153.50
## [104,]     NA        NA 351153.50
## [105,]     NA        NA 351153.50
## [106,]     NA        NA 351153.50
## [107,]     NA        NA 351153.50
## [108,]     NA        NA 351153.50
## [109,]     NA        NA 351153.50
## [110,]     NA        NA 351153.50
## [111,]     NA        NA 351153.50
## [112,]     NA        NA 351153.50
## [113,]     NA        NA 351153.50
## [114,]     NA        NA 351153.50
## [115,]     NA        NA 351153.50
## [116,]     NA        NA 351153.50
## [117,]     NA        NA 351153.50
## [118,]     NA        NA 351153.50
## [119,]     NA        NA 351153.50
## [120,]     NA        NA 351153.50

Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.

ts.plot(datampdw.ts, xlab="Time Period ", ylab="Volume Saham", main= "SMA N=4 Data Sales")
points(datampdw.ts)
lines(data.gab[,2],col="green",lwd=2)
lines(data.gab[,3],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.5)

Selanjutnya perhitungan akurasi dilakukan dengan ukuran akurasi Sum Squares Error (SSE), Mean Square Error (MSE) dan Mean Absolute Percentage Error (MAPE). Perhitungan akurasi dilakukan baik pada data latih maupun pada data uji.

#Menghitung nilai keakuratan data latih
error_train.sma = train_ma.ts-data.ramal[1:length(train_ma.ts)]
SSE_train.sma = sum(error_train.sma[5:length(train_ma.ts)]^2)
MSE_train.sma = mean(error_train.sma[5:length(train_ma.ts)]^2)
MAPE_train.sma = mean(abs((error_train.sma[5:length(train_ma.ts)]/train_ma.ts[5:length(train_ma.ts)])*100))

akurasi_train.sma <- matrix(c(SSE_train.sma, MSE_train.sma, MAPE_train.sma))
row.names(akurasi_train.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.sma) <- c("Akurasi m = 4")
akurasi_train.sma
##      Akurasi m = 4
## SSE   3.553100e+11
## MSE   3.862065e+09
## MAPE  2.153036e+01

Dalam hal ini nilai MAPE data latih pada metode pemulusan SMA kurang dari 3%, nilai ini dapat dikategorikan sebagai nilai akurasi yang sangat baik. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metode pemulusan SMA.

#Menghitung nilai keakuratan data uji
error_test.sma = test_ma.ts-data.gab[97:120,3]
SSE_test.sma = sum(error_test.sma^2)
MSE_test.sma = mean(error_test.sma^2)
MAPE_test.sma = mean(abs((error_test.sma/test_ma.ts*100)))

akurasi_test.sma <- matrix(c(SSE_test.sma, MSE_test.sma, MAPE_test.sma))
row.names(akurasi_test.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.sma) <- c("Akurasi m = 4")
akurasi_test.sma
##      Akurasi m = 4
## SSE   4.442887e+11
## MSE   1.851203e+10
## MAPE  2.365940e+01

Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE sebanyak 2.3% yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.

Double Moving Average (DMA)

Metode pemulusan Double Moving Average (DMA) pada dasarnya mirip dengan SMA. Namun demikian, metode ini lebih cocok digunakan untuk pola data trend. Proses pemulusan dengan rata rata dalam metode ini dilakukan sebanyak 2 kali.

dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)

t = 1:24
f = c()

for (i in t) {
  f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}

data.gab2 <- cbind(aktual = c(train_ma.ts,rep(NA,24)), pemulusan1 = c(data.sma,rep(NA,24)),pemulusan2 = c(data.dma, rep(NA,24)),At = c(At, rep(NA,24)), Bt = c(Bt,rep(NA,24)),ramalan = c(data.ramal2, f[-1]))
data.gab2
##        aktual pemulusan1 pemulusan2        At          Bt    ramalan
##   [1,]  97907         NA         NA        NA          NA         NA
##   [2,] 136954         NA         NA        NA          NA         NA
##   [3,] 141112         NA         NA        NA          NA         NA
##   [4,] 128263  126059.00         NA        NA          NA         NA
##   [5,] 135960  135572.25         NA        NA          NA         NA
##   [6,] 119400  131183.75         NA        NA          NA         NA
##   [7,]  95011  119658.50  105558.71 111198.62  -5639.9167         NA
##   [8,]  91423  110448.50   87503.08  96681.25  -9178.1667  105558.71
##   [9,] 113009  104710.75   85061.38  92921.12  -7859.7500   87503.08
##  [10,] 100552   99998.75   85489.79  91293.38  -5803.5833   85061.38
##  [11,]  89003   98496.75   90301.85  93579.81  -3277.9583   85489.79
##  [12,]  94061   99156.25   96765.62  97721.88   -956.2500   90301.85
##  [13,]  78078   90423.50   79431.31  83828.19  -4396.8750   96765.62
##  [14,]  89697   87709.75   77315.06  81472.94  -4157.8750   79431.31
##  [15,] 115971   94451.75   96979.15  95968.19   1010.9583   77315.06
##  [16,] 108673   98104.75  107158.60 103537.06   3621.5417   96979.15
##  [17,]  90306  101161.75  110836.33 106966.50   3869.8333  107158.60
##  [18,]  96246  102799.00  108915.15 106468.69   2446.4583  110836.33
##  [19,] 116638  102965.75  105812.31 104673.69   1138.6250  108915.15
##  [20,] 109811  103250.25  104427.02 103956.31    470.7083  105812.31
##  [21,] 127460  112538.75  124455.94 119689.06   4766.8750  104427.02
##  [22,] 114011  116980.00  130390.52 125026.31   5364.2083  124455.94
##  [23,] 111326  115652.00  121563.25 119198.75   2364.5000  130390.52
##  [24,] 168797  130398.50  149575.48 141904.69   7670.7917  121563.25
##  [25,] 147941  135518.75  153654.48 146400.19   7254.2917  149575.48
##  [26,] 117029  136273.25  147627.62 143085.88   4541.7500  153654.48
##  [27,] 137569  142834.00  153797.12 149411.88   4385.2500  147627.62
##  [28,] 142273  136203.00  133695.92 134698.75  -1002.8333  153797.12
##  [29,] 114090  127740.25  114369.62 119717.88  -5348.2500  133695.92
##  [30,] 115989  127480.25  117340.04 121396.12  -4056.0833  114369.62
##  [31,]  90296  115662.00   97146.38 104552.62  -7406.2500  117340.04
##  [32,] 109775  107537.50   87425.00  95470.00  -8045.0000   97146.38
##  [33,] 112610  107167.50   95010.31  99873.19  -4862.8750   87425.00
##  [34,] 138593  112818.50  116188.71 114840.62   1348.0833   95010.31
##  [35,]  93912  113722.50  119407.50 117133.50   2274.0000  116188.71
##  [36,] 126237  117838.00  126090.29 122789.38   3300.9167  119407.50
##  [37,]  79156  109474.50  102826.38 105485.62  -2659.2500  126090.29
##  [38,]  94791   98524.00   79581.08  87158.25  -7577.1667  102826.38
##  [39,] 131300  107871.00  106944.54 107315.12   -370.5833   79581.08
##  [40,] 114330  104894.25  104399.77 104597.56   -197.7917  106944.54
##  [41,]  94130  108637.75  114731.08 112293.75   2437.3333  104399.77
##  [42,] 143031  120697.75  137652.02 130870.31   6781.7083  114731.08
##  [43,] 107755  114811.50  119063.48 117362.69   1700.7917  137652.02
##  [44,] 176515  130357.75  149910.35 142089.31   7821.0417  119063.48
##  [45,] 160521  146955.50  178205.29 165705.38  12499.9167  149910.35
##  [46,] 269396  178546.75  238344.88 214425.62  23919.2500  178205.29
##  [47,] 283703  222533.75  310759.27 275469.06  35290.2083  238344.88
##  [48,] 270791  246102.75  325382.85 293670.81  31712.0417  310759.27
##  [49,] 303220  281777.50  364339.69 331314.81  33024.8750  325382.85
##  [50,] 415074  318197.00  403270.75 369241.25  34029.5000  364339.69
##  [51,] 275347  316108.00  358710.81 341669.69  17041.1250  403270.75
##  [52,] 203298  299234.75  291577.15 294640.19  -3063.0417  358710.81
##  [53,] 240022  283435.25  248754.42 262626.75 -13872.3333  291577.15
##  [54,] 141638  215076.25  109430.73 151688.94 -42258.2083  248754.42
##  [55,] 162203  186790.25   87883.79 127446.38 -39562.5833  109430.73
##  [56,] 186676  182634.75  125385.79 148285.38 -22899.5833   87883.79
##  [57,] 170331  165212.00  128184.81 142995.69 -14810.8750  125385.79
##  [58,] 198852  179515.50  181144.46 180492.88    651.5833  128184.81
##  [59,] 245943  200450.50  231279.35 218947.81  12331.5417  181144.46
##  [60,] 302241  229341.75  288861.44 265053.56  23807.8750  231279.35
##  [61,] 257196  251058.00  311002.27 287024.56  23977.7083  288861.44
##  [62,] 282210  271897.50  328081.77 305608.06  22473.7083  311002.27
##  [63,] 238661  270077.00  294216.06 284560.44   9655.6250  328081.77
##  [64,] 188754  241705.25  213406.60 224726.06 -11319.4583  294216.06
##  [65,] 184974  223649.75  176678.71 195467.12 -18788.4167  213406.60
##  [66,] 133077  186366.50  112894.62 142283.38 -29388.7500  176678.71
##  [67,] 203306  177527.75  127886.81 147743.19 -19856.3750  112894.62
##  [68,] 190500  177964.25  155609.56 164551.44  -8941.8750  127886.81
##  [69,] 178049  176233.00  170749.88 172943.12  -2193.2500  155609.56
##  [70,] 226767  199655.50  227672.79 216465.88  11206.9167  170749.88
##  [71,] 206276  200398.00  220123.52 212233.31   7890.2083  227672.79
##  [72,] 246509  214400.25  242281.19 231128.81  11152.3750  220123.52
##  [73,] 293512  243266.00  291326.10 272102.06  19224.0417  242281.19
##  [74,] 272166  254615.75  298692.00 281061.50  17630.5000  291326.10
##  [75,] 300768  278238.75  329253.02 308847.31  20405.7083  298692.00
##  [76,] 290020  289116.50  327128.58 311923.75  15204.8333  329253.02
##  [77,] 284584  286884.50  303002.21 296555.12   6447.0833  327128.58
##  [78,] 225371  275185.75  263234.71 268015.12  -4780.4167  303002.21
##  [79,] 400624  300149.75  320675.79 312465.38   8210.4167  263234.71
##  [80,] 338713  312323.00  343468.42 331010.25  12458.1667  320675.79
##  [81,] 307071  317944.75  345517.98 334488.69  11029.2917  343468.42
##  [82,] 383301  357427.25  416537.35 392893.31  23644.0417  345517.98
##  [83,] 228062  314286.75  295605.60 303078.06  -7472.4583  416537.35
##  [84,] 238175  289152.25  238234.75 258601.75 -20367.0000  295605.60
##  [85,] 164351  253472.25  169951.62 203359.88 -33408.2500  238234.75
##  [86,] 122322  188227.50   66465.52 115170.31 -48704.7917  169951.62
##  [87,] 143293  167035.25   71307.65 109598.69 -38291.0417   66465.52
##  [88,] 158484  147112.50   77363.54 105263.12 -27899.5833   71307.65
##  [89,] 137187  140321.50  106400.35 119968.81 -13568.4583   77363.54
##  [90,] 198152  159279.00  169015.56 165120.94   3894.6250  106400.35
##  [91,] 206979  175200.50  208070.71 194922.62  13148.0833  169015.56
##  [92,] 217089  189851.75  229332.69 213540.31  15792.3750  208070.71
##  [93,] 242612  216208.00  267996.65 247281.19  20715.4583  229332.69
##  [94,] 222994  222418.50  258249.85 243917.31  14332.5417  267996.65
##  [95,] 415152  274461.75  355673.00 323188.50  32484.5000  258249.85
##  [96,] 523856  351153.50  492975.27 436246.56  56728.7083  355673.00
##  [97,]     NA         NA         NA        NA          NA  492975.27
##  [98,]     NA         NA         NA        NA          NA  549703.98
##  [99,]     NA         NA         NA        NA          NA  606432.69
## [100,]     NA         NA         NA        NA          NA  663161.40
## [101,]     NA         NA         NA        NA          NA  719890.10
## [102,]     NA         NA         NA        NA          NA  776618.81
## [103,]     NA         NA         NA        NA          NA  833347.52
## [104,]     NA         NA         NA        NA          NA  890076.23
## [105,]     NA         NA         NA        NA          NA  946804.94
## [106,]     NA         NA         NA        NA          NA 1003533.65
## [107,]     NA         NA         NA        NA          NA 1060262.35
## [108,]     NA         NA         NA        NA          NA 1116991.06
## [109,]     NA         NA         NA        NA          NA 1173719.77
## [110,]     NA         NA         NA        NA          NA 1230448.48
## [111,]     NA         NA         NA        NA          NA 1287177.19
## [112,]     NA         NA         NA        NA          NA 1343905.90
## [113,]     NA         NA         NA        NA          NA 1400634.60
## [114,]     NA         NA         NA        NA          NA 1457363.31
## [115,]     NA         NA         NA        NA          NA 1514092.02
## [116,]     NA         NA         NA        NA          NA 1570820.73
## [117,]     NA         NA         NA        NA          NA 1627549.44
## [118,]     NA         NA         NA        NA          NA 1684278.15
## [119,]     NA         NA         NA        NA          NA 1741006.85
## [120,]     NA         NA         NA        NA          NA 1797735.56

Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut

ts.plot(datampdw.ts, xlab="Time Period ", ylab="Sales", main= "DMA N=4 Data Sales")
points(datampdw.ts)
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)

Selanjutnya perhitungan akurasi dilakukan baik pada data latih maupun data uji. Perhitungan akurasi dilakukan dengan ukuran akurasi SSE, MSE dan MAPE.

#Menghitung nilai keakuratan data latih
error_train.dma = train_ma.ts-data.ramal2[1:length(train_ma.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train_ma.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train_ma.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train_ma.ts)]/train_ma.ts[8:length(train_ma.ts)])*100))

akurasi_train.dma <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma))
row.names(akurasi_train.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.dma) <- c("Akurasi m = 4")
akurasi_train.dma
##      Akurasi m = 4
## SSE   3.251812e+11
## MSE   3.653721e+09
## MAPE  2.378664e+01

Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE sebesar 2.38% yang kurang dari 10% sehingga dikategorikan sangat baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.

#Menghitung nilai keakuratan data uji
error_test.dma = test_ma.ts-data.gab2[97:120,6]
SSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_ma.ts*100)))

akurasi_test.dma <- matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma))
row.names(akurasi_test.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.dma) <- c("Akurasi m = 4")
akurasi_test.dma
##      Akurasi m = 4
## SSE   1.431972e+13
## MSE   5.966548e+11
## MAPE  1.500678e+02

Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE sebesar 1.5% yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.

Pada data latih, metode SMA lebih baik dibandingkan dengan metode DMA, sedangkan pada data uji, metode DMA lebih baik dibandingkan SMA

Single Exponential Smoothing & Double Exponential Smoothing

Metode Exponential Smoothing adalah metode pemulusan dengan melakukan pembobotan menurun secara eksponensial. Nilai yang lebih baru diberi bobot yang lebih besar dari nilai terdahulu. Terdapat satu atau lebih parameter pemulusan yang ditentukan secara eksplisit, dan hasil pemilihan parameter tersebut akan menentukan bobot yang akan diberikan pada nilai pengamatan. Ada dua macam model, yaitu model tunggal dan ganda.

Pembagian Data

Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.

#membagi training dan testing
training<-datampdw[1:96,]
testing<-datampdw[97:120,]
train.ts <- ts(training$x)
test.ts <- ts(testing$x)

Eksplorasi

Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.

#eksplorasi data
plot(datampdw.ts, col="black",main="Plot semua data")
points(datampdw.ts)

plot(train.ts, col="red",main="Plot data latih")
points(train.ts)

plot(test.ts, col="blue",main="Plot data uji")
points(test.ts)

SES

Single Exponential Smoothing merupakan metode pemulusan yang tepat digunakan untuk data dengan pola stasioner atau konstan.

Nilai pemulusan pada periode ke-t didapat dari persamaan:

y~T=λyt+(1−λ)y~T−1

Nilai parameter λ adalah nilai antara 0 dan 1.

Nilai pemulusan periode ke-t bertindak sebagai nilai ramalan pada periode ke-(T+Ï„).

y~T+Ï„(T)=y~T

Pemulusan dengan metode SES dapat dilakukan dengan dua fungsi dari packages berbeda, yaitu (1) fungsi ses() dari packages forecast dan (2) fungsi HoltWinters dari packages stats .

#Cara 1 (fungsi ses)
ses.1 <- ses(train.ts, h = 24, alpha = 0.2)
plot(ses.1)

ses.1
##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  97       306318.5 223663.8 388973.3 179909.0 432728.1
##  98       306318.5 222026.9 390610.2 177405.6 435231.5
##  99       306318.5 220421.2 392215.9 174949.9 437687.2
## 100       306318.5 218844.9 393792.1 172539.2 440097.9
## 101       306318.5 217296.6 395340.5 170171.3 442465.8
## 102       306318.5 215774.8 396862.3 167843.8 444793.3
## 103       306318.5 214278.1 398359.0 165554.8 447082.3
## 104       306318.5 212805.3 399831.7 163302.4 449334.6
## 105       306318.5 211355.4 401281.6 161085.0 451552.1
## 106       306318.5 209927.3 402709.7 158900.9 453736.2
## 107       306318.5 208520.1 404117.0 156748.7 455888.4
## 108       306318.5 207132.8 405504.3 154627.1 458010.0
## 109       306318.5 205764.7 406872.4 152534.7 460102.4
## 110       306318.5 204414.9 408222.2 150470.4 462166.7
## 111       306318.5 203082.8 409554.3 148433.0 464204.0
## 112       306318.5 201767.6 410869.5 146421.7 466215.4
## 113       306318.5 200468.8 412168.3 144435.3 468201.8
## 114       306318.5 199185.7 413451.4 142473.0 470164.1
## 115       306318.5 197917.8 414719.3 140533.9 472103.1
## 116       306318.5 196664.6 415972.5 138617.3 474019.8
## 117       306318.5 195425.5 417211.6 136722.3 475914.8
## 118       306318.5 194200.1 418436.9 134848.3 477788.8
## 119       306318.5 192988.0 419649.1 132994.5 479642.6
## 120       306318.5 191788.7 420848.4 131160.3 481476.8
ses.2<- ses(train.ts, h = 24, alpha = 0.7)
plot(ses.2)

ses.2
##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  97       474230.3 408310.4 540150.2 373414.5 575046.1
##  98       474230.3 393764.8 554695.8 351168.9 597291.7
##  99       474230.3 381472.8 566987.8 332369.9 616090.7
## 100       474230.3 370629.0 577831.6 315785.8 632674.8
## 101       474230.3 360817.4 587643.2 300780.2 647680.4
## 102       474230.3 351789.5 596671.1 286973.2 661487.3
## 103       474230.3 343383.0 605077.6 274116.6 674343.9
## 104       474230.3 335484.9 612975.6 262037.6 686423.0
## 105       474230.3 328012.9 620447.7 250610.0 697850.6
## 106       474230.3 320904.5 627556.1 239738.7 708721.9
## 107       474230.3 314111.4 634349.2 229349.6 719111.0
## 108       474230.3 307595.0 640865.6 219383.6 729077.0
## 109       474230.3 301324.0 647136.6 209792.9 738667.7
## 110       474230.3 295272.6 653188.0 200538.1 747922.4
## 111       474230.3 289419.3 659041.3 191586.2 756874.4
## 112       474230.3 283745.7 664714.9 182909.3 765551.3
## 113       474230.3 278236.3 670224.3 174483.4 773977.2
## 114       474230.3 272877.6 675583.0 166287.9 782172.6
## 115       474230.3 267657.9 680802.7 158305.0 790155.5
## 116       474230.3 262566.8 685893.8 150518.9 797941.6
## 117       474230.3 257595.4 690865.2 142915.8 805544.8
## 118       474230.3 252735.5 695725.1 135483.2 812977.4
## 119       474230.3 247979.9 700480.6 128210.2 820250.3
## 120       474230.3 243322.3 705138.2 121087.1 827373.5

Untuk mendapatkan gambar hasil pemulusan pada data latih dengan fungsi ses() , perlu digunakan fungsi autoplot() dan autolayer() dari library packages ggplot2 .

autoplot(ses.1) +
  autolayer(fitted(ses.1), series="Fitted") +
  ylab("Membaca") + xlab("Periode")

Pada fungsi ses() , terdapat beberapa argumen yang umum digunakan, yaitu nilia y , gamma , beta , alpha , dan h .

Nilai y adalah nilai data deret waktu, gamma adalah parameter pemulusan untuk komponen musiman, beta adalah parameter pemulusan untuk tren, dan alpha adalah parameter pemulusan untuk stasioner, serta h adalah banyaknya periode yang akan diramalkan.

Kasus di atas merupakan contoh inisialisasi nilai parameter λ dengan nilai alpha 0,2 dan 0,7 dan banyak periode data yang akan diramalkan adalah sebanyak 10 periode. Selanjutnya akan digunakan fungsi HoltWinters() dengan nilai inisialisasi parameter dan panjang periode peramalan yang sama dengan fungsi ses() .

#Cara 2 (fungsi Holtwinter)
ses1<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses1)

#ramalan
ramalan1<- forecast(ses1, h=24)
ramalan1
##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  97       306318.5 224766.8 387870.3 181595.9 431041.2
##  98       306318.5 223151.7 389485.4 179125.9 433511.2
##  99       306318.5 221567.4 391069.6 176702.9 435934.2
## 100       306318.5 220012.2 392624.8 174324.5 438312.6
## 101       306318.5 218484.6 394152.5 171988.1 440649.0
## 102       306318.5 216983.0 395654.0 169691.7 442945.4
## 103       306318.5 215506.3 397130.8 167433.2 445203.8
## 104       306318.5 214053.2 398583.9 165210.9 447426.2
## 105       306318.5 212622.7 400014.4 163023.1 449614.0
## 106       306318.5 211213.6 401423.4 160868.1 451768.9
## 107       306318.5 209825.2 402811.9 158744.7 453892.4
## 108       306318.5 208456.4 404180.7 156651.3 455985.8
## 109       306318.5 207106.5 405530.6 154586.8 458050.2
## 110       306318.5 205774.8 406862.3 152550.1 460087.0
## 111       306318.5 204460.4 408176.7 150540.0 462097.1
## 112       306318.5 203162.8 409474.3 148555.4 464081.7
## 113       306318.5 201881.3 410755.8 146595.6 466041.5
## 114       306318.5 200615.3 412021.7 144659.5 467977.6
## 115       306318.5 199364.4 413272.7 142746.3 469890.8
## 116       306318.5 198127.9 414509.2 140855.2 471781.9
## 117       306318.5 196905.3 415731.7 138985.5 473651.6
## 118       306318.5 195696.3 416940.8 137136.5 475500.6
## 119       306318.5 194500.4 418136.7 135307.4 477329.7
## 120       306318.5 193317.1 419320.0 133497.7 479139.4
ses2<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses2)

#ramalan
ramalan2<- forecast(ses2, h=24)
ramalan2
##     Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
##  97       474230.3 408694.6 539766.0 374002.1 574458.5
##  98       474230.3 394233.8 554226.8 351886.2 596574.4
##  99       474230.3 382013.4 566447.2 333196.7 615263.9
## 100       474230.3 371232.8 577227.7 316709.3 631751.3
## 101       474230.3 361478.4 586982.2 301791.2 646669.4
## 102       474230.3 352503.1 595957.5 288064.7 660395.9
## 103       474230.3 344145.6 604314.9 275283.0 673177.6
## 104       474230.3 336293.6 612167.0 263274.3 685186.3
## 105       474230.3 328865.1 619595.5 251913.4 696547.2
## 106       474230.3 321798.1 626662.4 241105.4 707355.1
## 107       474230.3 315044.6 633416.0 230776.8 717683.8
## 108       474230.3 308566.2 639894.4 220868.9 727591.6
## 109       474230.3 302331.8 646128.8 211334.2 737126.4
## 110       474230.3 296315.6 652144.9 202133.3 746327.3
## 111       474230.3 290496.4 657964.2 193233.6 755227.0
## 112       474230.3 284855.9 663604.7 184607.2 763853.4
## 113       474230.3 279378.6 669081.9 176230.4 772230.2
## 114       474230.3 274051.2 674409.4 168082.7 780377.8
## 115       474230.3 268861.9 679598.7 160146.4 788314.2
## 116       474230.3 263800.5 684660.1 152405.6 796054.9
## 117       474230.3 258858.0 689602.6 144846.8 803613.8
## 118       474230.3 254026.4 694434.1 137457.5 811003.0
## 119       474230.3 249298.6 699162.0 130227.0 818233.6
## 120       474230.3 244668.2 703792.4 123145.3 825315.3

Fungsi HoltWinters memiliki argumen yang sama dengan fungsi ses() . Argumen-argumen kedua fungsi dapat dilihat lebih lanjut dengan ?ses() atau ?HoltWinters .

Nilai parameter α dari kedua fungsi dapat dioptimalkan menyesuaikan dari error-nya paling minimumnya. Caranya adalah dengan membuat parameter α= NULL .

#SES
ses.opt <- ses(train.ts, h = 24, alpha = NULL)
plot(ses.opt)

ses.opt
##     Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
##  97       498440.3 433083.4 563797.1 398485.54 598395.0
##  98       498440.3 413851.3 583029.2 369072.56 627807.9
##  99       498440.3 398245.1 598635.4 345204.95 651675.6
## 100       498440.3 384761.5 612119.0 324583.66 672296.8
## 101       498440.3 372715.8 624164.7 306161.37 690719.1
## 102       498440.3 361727.4 635153.1 289356.00 707524.5
## 103       498440.3 351558.7 645321.8 273804.37 723076.1
## 104       498440.3 342049.9 654830.6 259261.79 737618.7
## 105       498440.3 333086.9 663793.6 245554.12 751326.4
## 106       498440.3 324585.4 672295.1 232552.21 764328.3
## 107       498440.3 316480.7 680399.8 220157.11 776723.4
## 108       498440.3 308721.9 688158.6 208291.05 788589.5
## 109       498440.3 301268.2 695612.4 196891.55 799989.0
## 110       498440.3 294086.1 702794.4 185907.57 810972.9
## 111       498440.3 287148.1 709732.4 175296.74 821583.8
## 112       498440.3 280430.7 716449.8 165023.42 831857.1
## 113       498440.3 273914.2 722966.3 155057.31 841823.2
## 114       498440.3 267581.6 729298.9 145372.41 851508.1
## 115       498440.3 261418.1 735462.4 135946.18 860934.3
## 116       498440.3 255410.9 741469.6 126758.92 870121.6
## 117       498440.3 249548.6 747331.9 117793.35 879087.2
## 118       498440.3 243821.3 753059.2 109034.14 887846.4
## 119       498440.3 238220.0 758660.5 100467.66 896412.8
## 120       498440.3 232736.7 764143.8  92081.75 904798.8
#Lamda Optimum Holt Winter
sesopt<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE,alpha = NULL)
sesopt
## Holt-Winters exponential smoothing without trend and without seasonal component.
## 
## Call:
## HoltWinters(x = train.ts, alpha = NULL, beta = FALSE, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.8227594
##  beta : FALSE
##  gamma: FALSE
## 
## Coefficients:
##       [,1]
## a 498634.4
plot(sesopt)

#ramalan
ramalanopt<- forecast(sesopt, h=24)
ramalanopt
##     Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
##  97       498634.4 433605.4 563663.5 399181.06 598087.8
##  98       498634.4 414424.1 582844.7 369845.86 627423.0
##  99       498634.4 398864.8 598404.0 346049.96 651218.9
## 100       498634.4 385424.1 611844.7 325494.19 671774.6
## 101       498634.4 373417.9 623850.9 307132.30 690136.5
## 102       498634.4 362466.2 634802.6 290383.16 706885.7
## 103       498634.4 352332.1 644936.7 274884.31 722384.5
## 104       498634.4 342855.8 654413.0 260391.62 736877.2
## 105       498634.4 333923.9 663345.0 246731.35 750537.5
## 106       498634.4 325451.9 671816.9 233774.68 763494.2
## 107       498634.4 317375.6 679893.3 221422.94 775845.9
## 108       498634.4 309644.0 687624.8 209598.56 787670.3
## 109       498634.4 302216.6 695052.3 198239.26 799029.6
## 110       498634.4 295059.9 702208.9 187294.13 809974.7
## 111       498634.4 288146.5 709122.3 176720.93 820547.9
## 112       498634.4 281453.0 715815.8 166484.12 830784.7
## 113       498634.4 274959.7 722309.1 156553.52 840715.3
## 114       498634.4 268649.7 728619.1 146903.18 850365.7
## 115       498634.4 262508.3 734760.6 137510.63 859758.2
## 116       498634.4 256522.5 740746.3 128356.26 868912.6
## 117       498634.4 250681.3 746587.6 119422.82 877846.0
## 118       498634.4 244974.5 752294.3 110695.04 886573.8
## 119       498634.4 239393.3 757875.5 102159.35 895109.5
## 120       498634.4 233929.8 763339.1  93803.58 903465.3

Setelah dilakukan peramalan, akan dilakukan perhitungan keakuratan hasil peramalan. Perhitungan akurasi ini dilakukan baik pada data latih dan data uji.

Akurasi Data Latih

Perhitungan akurasi data dapat dilakukan dengan cara langsung maupun manual. Secara langsung, nilai akurasi dapat diambil dari objek yang tersimpan pada hasil SES, yaitu sum of squared errors (SSE). Nilai akurasi lain dapat dihitung pula dari nilai SSE tersebut.

#Keakuratan Metode
#Pada data training
SSE1<-ses1$SSE
MSE1<-ses1$SSE/length(train.ts)
RMSE1<-sqrt(MSE1)

akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi lamda=0.2")
akurasi1
##      Akurasi lamda=0.2
## SSE       3.920775e+11
## MSE       4.084141e+09
## RMSE      6.390728e+04
SSE2<-ses2$SSE
MSE2<-ses2$SSE/length(train.ts)
RMSE2<-sqrt(MSE2)

akurasi2 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi2)<- c("SSE", "MSE", "RMSE")
colnames(akurasi2) <- c("Akurasi lamda=0.7")
akurasi2
##      Akurasi lamda=0.7
## SSE       2.488591e+11
## MSE       2.592282e+09
## RMSE      5.091446e+04
#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA 39047.0000 35395.6000 15467.4800 20070.9840  -503.2128
resid1<-training$x-ramalan1$fitted
head(resid1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA 39047.0000 35395.6000 15467.4800 20070.9840  -503.2128
#Cara Manual
SSE.1=sum(sisaan1[2:length(train.ts)]^2)
SSE.1
## [1] 392077527560
MSE.1 = SSE.1/length(train.ts)
MSE.1
## [1] 4084140912
MAPE.1 = sum(abs(sisaan1[2:length(train.ts)]/train.ts[2:length(train.ts)])*
               100)/length(train.ts)
MAPE.1
## [1] 21.75827
akurasi.1 <- matrix(c(SSE.1,MSE.1,MAPE.1))
row.names(akurasi.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.1) <- c("Akurasi lamda=0.2")
akurasi.1
##      Akurasi lamda=0.2
## SSE       3.920775e+11
## MSE       4.084141e+09
## MAPE      2.175827e+01
fitted2<-ramalan2$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA  39047.000  15872.100  -8087.370   5270.789 -14978.763
resid2<-training$x-ramalan2$fitted
head(resid2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA  39047.000  15872.100  -8087.370   5270.789 -14978.763
SSE.2=sum(sisaan2[2:length(train.ts)]^2)
SSE.2
## [1] 248859116938
MSE.2 = SSE.2/length(train.ts)
MSE.2
## [1] 2592282468
MAPE.2 = sum(abs(sisaan2[2:length(train.ts)]/train.ts[2:length(train.ts)])*
               100)/length(train.ts)
MAPE.2
## [1] 17.66957
akurasi.2 <- matrix(c(SSE.2,MSE.2,MAPE.2))
row.names(akurasi.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.2) <- c("Akurasi lamda=0.7")
akurasi.2
##      Akurasi lamda=0.7
## SSE       2.488591e+11
## MSE       2.592282e+09
## MAPE      1.766957e+01

Berdasarkan nilai SSE, MSE, RMSE, dan MAPE di antara kedua parameter, nilai parameter λ=0,7 menghasilkan akurasi yang lebih baik dibanding λ=0,2 . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan sangat baik.

Akurasi Data Uji

Akurasi data uji dapat dihitung dengan cara yang hampir sama dengan perhitungan akurasi data latih.

selisih1<-ramalan1$mean-testing$x
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing)

selisih2<-ramalan2$mean-testing$x
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing)

selisihopt<-ramalanopt$mean-testing$x
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing)

akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting1
##                [,1]
## SSE1   721606264719
## SSE2   179007160725
## SSEopt 212785575544
akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2
##                [,1]
## MSE1   360803132359
## MSE2    89503580362
## MSEopt 106392787772

Selain dengan cara di atas, perhitungan nilai akurasi dapat menggunakan fungsi accuracy() dari package forecast . Penggunaannya yaitu dengan menuliskan accuracy(hasil ramalan, kondisi aktual) . Contohnya adalah sebagai berikut.

#cara lain
accuracy(ramalanopt,testing$x)
##                      ME     RMSE      MAE        MPE     MAPE     MASE
## Training set   5126.874 50734.38 34913.79  -1.020569 18.25255 0.960577
## Test set     -41038.043 94159.79 73409.72 -13.179694 18.74972 2.019709
##                     ACF1
## Training set -0.02144522
## Test set              NA

DES

Metode pemulusan Double Exponential Smoothing (DES) digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk periode berikutnya.

Pemulusan dengan metode DES kali ini akan menggunakan fungsi HoltWinters() . Jika sebelumnya nilai argumen beta dibuat FALSE , kali ini argumen tersebut akan diinisialisasi bersamaan dengan nilai alpha .

#Lamda=0.2 dan gamma=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)

#ramalan
ramalandes1<- forecast(des.1, h=24)
ramalandes1
##     Point Forecast    Lo 80     Hi 80     Lo 95     Hi 95
##  97       300147.1 194005.9  406288.2 137818.22  462475.9
##  98       316947.1 207791.9  426102.3 150008.61  483885.6
##  99       333747.1 220618.4  446875.8 160731.64  506762.5
## 100       350547.1 232429.6  468664.6 169901.99  531192.2
## 101       367347.1 243202.8  491491.4 177484.79  557209.4
## 102       384147.1 252943.6  515350.6 183488.68  584805.5
## 103       400947.1 261679.6  540214.6 187955.82  613938.4
## 104       417747.1 269453.1  566041.1 190951.00  644543.2
## 105       434547.1 276314.9  592779.3 192551.88  676542.4
## 106       451347.1 282319.3  620375.0 192841.30  709853.0
## 107       468147.1 287520.0  648774.3 191901.77  744392.5
## 108       484947.1 291968.7  677925.6 189812.04  780082.3
## 109       501747.2 295713.0  707781.3 186645.14  816849.2
## 110       518547.2 298796.6  738297.8 182467.62  854626.7
## 111       535347.2 301258.4  769435.9 177339.35  893355.0
## 112       552147.2 303133.6  801160.7 171313.85  932980.5
## 113       568947.2 304453.4  833441.0 164438.78  973455.6
## 114       585747.2 305245.3  866249.1 156756.52 1014737.8
## 115       602547.2 305534.0  899560.3 148304.76 1056789.6
## 116       619347.2 305341.6  933352.8 139117.09 1099577.3
## 117       636147.2 304687.6  967606.8 129223.53 1143070.9
## 118       652947.2 303589.7 1002304.7 118650.96 1187243.5
## 119       669747.2 302063.5 1037430.9 107423.57 1232070.9
## 120       686547.2 300123.5 1072970.9  95563.17 1277531.3
#Lamda=0.6 dan gamma=0.3
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)

#ramalan
ramalandes2<- forecast(des.2, h=24)
ramalandes2
##     Point Forecast     Lo 80     Hi 80    Lo 95     Hi 95
##  97       535420.7  465327.0  605514.5 428221.6  642619.9
##  98       601260.9  512366.1  690155.8 465308.0  737213.9
##  99       667101.1  555610.1  778592.1 496590.4  837611.9
## 100       732941.3  595772.2  870110.4 523159.3  942723.3
## 101       798781.5  633324.5  964238.5 545736.9 1051826.1
## 102       864621.7  668584.5 1060658.8 564808.7 1164434.7
## 103       930461.9  701775.6 1159148.1 580716.4 1280207.4
## 104       996302.1  733062.8 1259541.3 593712.3 1398891.8
## 105      1062142.2  762573.5 1361711.0 603991.4 1520293.1
## 106      1127982.4  790409.7 1465555.1 611709.5 1644255.4
## 107      1193822.6  816655.5 1570989.7 616995.3 1770649.9
## 108      1259662.8  841382.0 1677943.6 619957.5 1899368.1
## 109      1325503.0  864650.3 1786355.6 620689.7 2030316.3
## 110      1391343.2  886514.1 1896172.2 619273.8 2163412.6
## 111      1457183.4  907020.8 2007345.9 615782.3 2298584.4
## 112      1523023.5  926212.9 2119834.2 610280.5 2435766.6
## 113      1588863.7  944128.9 2233598.5 602826.9 2574900.5
## 114      1654703.9  960803.7 2348604.1 593475.2 2715932.6
## 115      1720544.1  976269.5 2464818.7 582274.4 2858813.8
## 116      1786384.3  990555.8 2582212.7 569269.7 3003498.9
## 117      1852224.5 1003690.0 2700758.9 554503.0 3149945.9
## 118      1918064.7 1015697.6 2820431.7 538013.3 3298116.0
## 119      1983904.8 1026602.3 2941207.4 519837.0 3447972.7
## 120      2049745.0 1036426.4 3063063.6 500008.0 3599482.1

Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.

#Visually evaluate the prediction
plot(datampdw.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")

Untuk mendapatkan nilai parameter optimum dari DES, argumen alpha dan beta dapat dibuat NULL seperti berikut.

#Lamda dan gamma optimum
des.opt<- HoltWinters(train.ts, gamma = FALSE)
des.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
## 
## Call:
## HoltWinters(x = train.ts, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.7844551
##  beta : 0.2122358
##  gamma: FALSE
## 
## Coefficients:
##        [,1]
## a 499607.77
## b  54145.85
plot(des.opt)

#ramalan
ramalandesopt<- forecast(des.opt, h=24)
ramalandesopt
##     Point Forecast    Lo 80     Hi 80    Lo 95     Hi 95
##  97       553753.6 485312.4  622194.9 449081.7  658425.5
##  98       607899.5 513453.1  702345.8 463456.2  752342.7
##  99       662045.3 540517.2  783573.5 476184.1  847906.6
## 100       716191.2 566221.8  866160.6 486832.8  945549.6
## 101       770337.0 590490.0  950184.1 495284.7 1045389.4
## 102       824482.9 613316.5 1035649.3 501531.8 1147434.0
## 103       878628.7 634724.5 1122533.0 505609.4 1251648.1
## 104       932774.6 654747.9 1210801.3 507569.5 1357979.7
## 105       986920.5 673424.8 1300416.1 507470.3 1466370.6
## 106      1041066.3 690793.5 1391339.1 505370.3 1576762.3
## 107      1095212.2 706891.4 1483533.0 501326.7 1689097.6
## 108      1149358.0 721753.9 1576962.1 495394.0 1803322.1
## 109      1203503.9 735414.8 1671592.9 487623.4 1919384.3
## 110      1257649.7 747905.7 1767393.8 478063.4 2037236.0
## 111      1311795.6 759256.1 1864335.1 466759.3 2156831.8
## 112      1365941.4 769493.9 1962389.0 453753.6 2278129.3
## 113      1420087.3 778645.1 2061529.5 439086.1 2401088.5
## 114      1474233.1 786734.2 2161732.1 422794.2 2525672.0
## 115      1528379.0 793784.3 2262973.7 404913.3 2651844.7
## 116      1582524.9 799816.9 2365232.8 385476.4 2779573.3
## 117      1636670.7 804852.6 2468488.8 364514.7 2908826.7
## 118      1690816.6 808910.7 2572722.4 342058.0 3039575.2
## 119      1744962.4 812009.5 2677915.4 318134.0 3171790.8
## 120      1799108.3 814166.2 2784050.3 292769.4 3305447.1

Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE.

Akurasi Data Latih

#Akurasi Data Training
ssedes.train1<-des.1$SSE
msedes.train1<-ssedes.train1/length(train.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]         NA         NA  -34889.00  -78411.64  -89547.29 -119130.91
mapedes.train1 <- sum(abs(sisaandes1[3:length(train.ts)]/train.ts[3:length(train.ts)])
                      *100)/length(train.ts)

akurasides.1 <- matrix(c(ssedes.train1,msedes.train1,mapedes.train1))
row.names(akurasides.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.1) <- c("Akurasi lamda=0.2 dan gamma=0.2")
akurasides.1
##      Akurasi lamda=0.2 dan gamma=0.2
## SSE                     6.412284e+11
## MSE                     6.679462e+09
## MAPE                    3.621965e+01
ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(train.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1]        NA        NA -34889.00 -59571.58 -38175.73 -47002.76
mapedes.train2 <- sum(abs(sisaandes2[3:length(train.ts)]/train.ts[3:length(train.ts)])
                      *100)/length(train.ts)

akurasides.2 <- matrix(c(ssedes.train2,msedes.train2,mapedes.train2))
row.names(akurasides.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.2) <- c("Akurasi lamda=0.6 dan gamma=0.3")
akurasides.2
##      Akurasi lamda=0.6 dan gamma=0.3
## SSE                     2.784438e+11
## MSE                     2.900457e+09
## MAPE                    2.107291e+01

Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik dikarenakan memiliki SSE, MSE dan MAPE yang lebih kecil. Namun untuk kedua skenario dapat dikategorikan peramalan sangat baik berdasarkan nilai MAPE-nya.

Akurasi Data Uji

#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-testing$x
selisihdes1
## Time Series:
## Start = 97 
## End = 120 
## Frequency = 1 
##  [1] -172224.921  -34971.915  -52369.909   32731.097   83390.103  -54695.891
##  [7]   28885.115  -48304.879  -54178.872  -22029.866  -52517.860  -39596.854
## [13]   86599.152   76206.158     562.164   69172.170  238337.176   46010.182
## [19]  148476.188   45346.194  -12941.800  169507.206  226161.213  150467.219
SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$x)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$x)*100)/length(testing$x)

selisihdes2<-ramalandes2$mean-testing$x
selisihdes2
## Time Series:
## Start = 97 
## End = 120 
## Frequency = 1 
##  [1]   63048.75  249341.94  280984.12  415125.31  514824.49  425778.68
##  [7]  558399.86  530250.05  573416.24  654605.42  673157.61  735118.79
## [13]  910354.98  949002.17  922398.35 1040048.54 1258253.72 1114966.91
## [19] 1266473.09 1212383.28 1203135.47 1434624.65 1540318.84 1513665.02
SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$x)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$x)*100)/length(testing$x)

selisihdesopt<-ramalandesopt$mean-testing$x
selisihdesopt
## Time Series:
## Start = 97 
## End = 120 
## Frequency = 1 
##  [1]   81381.62  255980.47  275928.33  398375.18  486380.04  385639.89
##  [7]  506566.75  466722.60  498194.45  567689.31  574547.16  624814.02
## [13]  788355.87  815308.73  777010.58  882966.44 1089477.29  934496.14
## [19] 1074308.00 1008523.85  987581.71 1207376.56 1301376.42 1263028.27
SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$x)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$x)*100)/length(testing$x)

akurasitestingdes <-
  matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
           MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
         nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes
##          des ske1     des ske2      des opt
## SSE  2.593627e+11 2.083909e+13 1.508068e+13
## MSE  1.080678e+10 8.682954e+11 6.283619e+11
## MAPE 1.889296e+01 1.818946e+02 1.575722e+02

Perbandingan SES dan DES

MSEfull <-
  matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt,MSEtestingdes1,MSEtestingdes2,
           MSEtestingdesopt),nrow=3,ncol=2)
row.names(MSEfull)<- c("ske 1", "ske 2", "ske opt")
colnames(MSEfull) <- c("SES","DES")
MSEfull
##                  SES          DES
## ske 1   360803132359  10806779715
## ske 2    89503580362 868295369128
## ske opt 106392787772 628361861428

Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Contoh di atas adalah perbandingan kedua metode dengan ukuran akurasi MSE. Hasilnya didapatkan metode DES lebih baik dibandingkan metode SES pada ske 1 dilihat dari MSE yang lebih kecil nilainya sedangkan ske 2 dan ske opt SES lebih baik daripada DES dari MSE yang lebih kecil nilainya.